00100	C   SUBRS.   SCANR, NALF, EDIT, PRESCN
00200	
00300	C ***** MSS SCANNER *************************  
00400		SUBROUTINE SCANR
00500		DIMENSION IQ(10),LRUD(4)
00600		COMMON/ALF/INP(72),ML
00700		COMMON /SC/J,L,MK
00800		1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST,NFLG,IXX,ISEMI,QQ
00900		1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
01000		EQUIVALENCE  (IQ(1),VX(41)),(VX1,VX(1)),(VX2,VX(2)),(LDN,LRUD(4))
01100		DATA IBLA/' '/,LRUD/'L','R','U','D'/
01200	C  FOR LEFT, RIGHT, UP, DOWN, EDIT
01300	      NNUM=-1     
01400	      ISKP=0
01500	      JJ=0  
01600		XMINUS=1.    
01700	C  LEAVES BLANK WHEN REST.
01800	999      IDECI=-1  
01900	      M=0   
02000	2799	N=INP(ML)
02100	899   ML=ML+1
02200	781	IF(N.EQ.'/')N=ISEMI
02300	C   FOR MOTIVIC TRANFORMATIONS
02380		IF(N.EQ.'*')GO TO 751
02400		IF(N.EQ.ISEMI)GO TO 751
02500	C  '*' AND '/' ADDED ABOVE 4/18/73
02600		IF(N.NE.'X')GO TO 22
02650		IF(JN)GO TO 22
02700		IF(ISKP.EQ.0)GO TO 210
02800		ML=ML-1
02900		GO TO 202
03000	22	IF(N.EQ.IBLA)GO TO 4702
03050		IF(N.NE.',')GO TO 510
03100	4702      IF(ISKP)202,2799,2799
03200	512	ML=ML+1
03300		IF(INP(ML).EQ.ISEMI)RETURN
03400		GO TO 512
03500	
03600	510	IF(JN.GE.0)GO TO 173
03700	C  SKIP(JN=+1) IF NOT COMING FROM 'EDIT'
03800		JN=1
03900		DO 702 K=1,4
04000	702	IF(N.EQ.LRUD(K))GO TO 703
04100	C  FINDS L, R, U, D 
04200	C  YOU CAN TYPE THE FULL WORD
04300	703	JJ=JJ+1
04400		IF(K.NE.4)GO TO 77
04450		IF(INP(ML).EQ.'E')K=99
04500	C   'DE'=DELETE
04600	77	IF(N.EQ.'E')K=55
04700	C   'E'= EDIT
04800		IF(N.EQ.'C')K=2222
04900		IF(N.EQ.'X')K=222
05000	C   'C'=COPY, 'X'=EXIT FROM EDIT MODE
05100		VX(JJ)=K
05200	704	IF(INP(ML).EQ.IBLA)GO TO 2799
05250		IF(INP(ML).EQ.',')GO TO 2799
05300	C  PUT COMMA ERASER IN SCX.
05400		ML=ML+1
05500	C  SO IT WILL SKIP 'D' AND 'EL' IN 'EDIT' AND 'DEL'
05600		GO TO 704
05700	173	K=NALF(N)
05800		IF(N.GT.0)GO TO 1410
05900	C   JUMP IF NOT A LETTER
06000		QQ=0
06100		IF(K.LT.8)GO TO 15
06200	C   JUMP IF A POSSIBLE NOTE
06300		IF(K.NE.11)GO TO 16
06400	C   JUMP IF NOT A KSIG
06500	18	N=INP(ML)
06600		ML=ML+1
06700		IF(N.EQ.IBLA)GO TO 18
06750		IF(N.EQ.'S')GO TO 18
06775		IF(N.EQ.'+')GO TO 18
06800		IF(N.EQ.ISEMI)GO TO 20
06900		IF(N.EQ.'-')GO TO 177
06950		IF(N.NE.'F')GO TO 19
07000	177	QQ=-10000.
07100		GO TO 18
07200	19	A=NALF(N)
07300		GO TO 18
07400	20	VX(1)=-A*1000.-99.+QQ
07500	C  -4099=4 SHARPS, -14099=4 FLATS, ETC.
07600		RETURN
07700	16	IF(K.NE.9)GO TO 2
07800		VX(1)=22.
07900	C   FOR EDIT I21 ETC.
08000		GO TO 2799
08100	2	IF(K.NE.13)GO TO 3
08200	C   JUMP IF NOT A MEASURE LINE
08300		VX(1)=-599.
08400		K=NALF(INP(ML))
08500		IF(K.LE.0)GO TO 512
08550		IF(K.LE.9)VX(1)=-599.-K
08600	C  'M2'= A BAR LINE UP 2 STAVES. ETC.
08700		GO TO 512
08800	3	IF(K.GT.16)GO TO 4
08900	C   JUMP IF NOT FOR 'PROXIMITY' MODE
09000		NSWCH=K-15
09100		GO TO 2799
09200	C  TO SWITCH ALWAYS USE OCT.#  /PBF4/  /OE5/  P=PROXIMITY, O=ORDINARY
09300	4	IF(K.EQ.18)GO TO 73
09400	C   JUMP IF A REST
09500		IF(K.NE.20)GO TO 21
09600	C   TRY AGAIN IF NOT A 'T'
09700		IF(INP(ML).GT.0)GO TO 2799
09800	C T12,8/ ETC. MAKES A METER, OR TIME SIG.  POS NUMS ARE NOT LETTERS!
09900		VX(1)=-199.
10000		IF(INP(ML).EQ.'E')VX(1)=-499.
10100		GO TO 51
10200	21	IF(K.NE.19)GO TO 899
10300	C JUMP IF NOT 'S' STEM
10400		VX(1)=-699.
10500	C UP=-699
10600		IF(INP(ML).EQ.LDN)VX(1)=-799.
10700		GO TO 512
10800	C   NEXT IT'S A NOTE OR CLEF
10900	15	NNUM=K-2
11000		IF(NNUM.LE.0)NNUM=NNUM+7
11100		N=INP(ML)
11200		IF(N.NE.'A')GO TO 5
11300	C   JUMP IF NOT BASS CLEF
11400		VX(1)=-299.
11500	51	IF(XMINUS)VX(1)=VX(1)-.5
11600	C TYPE '-BA' FOR INVISIBLE BASS CLEF, ETC.
11700		GO TO 512
11800	5	IF(N.NE.'L')GO TO 6
11900	C   JUMP IF NOT ALTO CLEF
12000		VX(1)=-399.
12100		GO TO 51
12200	6	K=1
12300		IF(NNUM.GT.3)K=2
12400		NNUM=NNUM+NNUM-K
12500	C   FOUND A NOTE
12600	
12700		IF(N.EQ.'X')GO TO 5410
12800	C FOR GX3/ ETC.
12900		K=NALF(N)
13000		IF(N.GT.0)GO TO 7
13100	C   JUMP IF NOT A LETTER
13200		QQ=10000.
13300		IF(K.EQ.14)GO TO 610
13400		IF(K.EQ.19)GO TO 8
13500	C   JUMP IF NATURAL
13600		QQ=100.
13700		NNUM=NNUM-1
13800		GO TO 610
13900	8	QQ=1000.
14000		NNUM=NNUM+1
14100	610	ML=ML+1
14200		K=NALF(INP(ML))
14300	7	IF(K.EQ.11)GO TO 5410
14350		IF(K.LT.0)GO TO 5410
14400	C   JUMP IF SEMICOLON OR BLANK
14500		IF(K.NE.24)GO TO 24
14600		ML=ML-1
14700		GO TO 5410
14800	24	JSCA=K-1
14900		ML=ML+1
15000		KN=0
15100		GO TO 2410
15200	5410	KN=-1
15300	6410	IF(NSWCH.EQ.0)GO TO 2410
15400	C   K=-16 IS A BLANK??
15500		IF(K.EQ.-3)GO TO 277
15550		IF(K.NE.-5)GO TO 7410
15600	277	NOLD=NOLD-6*(K+4)
15700		ML=ML+1
15800	C  -=-3  +=-5  /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
15900	7410	IF(NOLD-NNUM.LE.5)GO TO 377
15950		IF(JSCA.LT.7)JSCA=JSCA+1
16000	377	IF(NOLD-NNUM.GE.-5)GO TO 2410
16050		IF(JSCA.GT.0)JSCA=JSCA-1
16100	C   WILL JUMP TO NEAREST NOTE ***********  MAY 22,71
16200	2410	JJ=1
16300		VX2=0
16400		VX1=(JSCA*12+NNUM+QQ)*DBST
16500	C  DOUBLE STOPS ARE NEG. NUMBERS
16600		NOLD=NNUM
16700	4410	NNUM=-2
16800		IF(INP(ML).EQ.ISEMI)RETURN
16900	C ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
17000		GO TO 310
17100	210	JJ=JJ+1
17200		IF(JJ.EQ.1)GO TO 3310
17300		XMINUS=1.
17400		VX(JJ)=0
17500	C  'X N1,N2' MAY REPLACE 'REP N1,N2'.  N2=0 BECOMES N2=2
17600		GO TO 310
17700	
17800	C   JUMP IF A LETTER
17900	1410	IF(N.NE.'-')GO TO 14
18000		XMINUS=-1.
18100		GO TO 2799
18200	14	ISKP=-1
18300		IF(N.NE.'.')GO TO 79
18400		IDECI=M
18500		GO TO 75
18600	79    M=M+1 
18700	      IQ(M)=NALF(N)
18800	
18900	75	IF(N.EQ.ISEMI)GO TO 751
18950		IF(INP(ML).NE.1)GO TO 2799
19000	751	IF(ISKP.EQ.0)RETURN
19100	202   IF(IDECI.NE.-1)GO TO 302    
19200	      IDECI=0     
19300	      GO TO 402   
19400	302   IDECI=M-IDECI     
19500	402   KN=0  
19600	      IEXP=M-1    
19700	      IF(M.LT.1)M=1     
19800	      DO 171 K=1,M
19900		IF(IEXP.GT.1)GO TO 1
20000		KV=10
20100		IF(IEXP.EQ.0)KV=1
20200		GO TO 11
20300	1	KV=10**IEXP
20400	11    KN=KN+IQ(K)*KV 
20500	171     IEXP=IEXP-1     
20600	      A=10**IDECI 
20700		IF(IDECI.EQ.0)A=1.
20800		JJ=JJ+1
20900		VX(JJ)=KN/A*XMINUS
21000		JN=-JN
21100	C   SETS IT TO -1 FOR L,R,U,D EDIT ROUTINE
21200		IF(MODE.NE.2)XMINUS=1.
21300	C************: MODE #?
21400	C  ONLY ONE - NEEDED FOR RHY.COMPOSITE
21500	1310	IF(INP(ML).NE.1)GO TO 310
21600		VX(JJ+1)=VX(JJ)*2.
21700		JJ=JJ+1
21800		ML=ML+1
21900		GO TO 1310
22000	206	ML=ML+2
22100	3310	VX(1)=-99.
22200	310      ISKP=0
22300	        IF(N.NE.ISEMI)GO TO 999
22400	
22500	    	RETURN
22600	73	JJ=JJ+1
22700		 IF(INP(ML).EQ.'E')GO TO 206    
22800	C   NEXT IS FOR A REST/R/ OR /RI/ FOR INVIS. REST  
22900	      VX(JJ)=85.
23000		IF(INP(ML).NE.'I')GO TO 4410
23100		VX(JJ)=86.
23200		ML=ML+1
23300		GO TO 4410
23400	  	END
23500	
23600	
23700	
23800		FUNCTION NALF(I)
23900		J='A'
24000		M=-1
24100		IF(I.LT.0)GO TO 10
24200		J=' '
24300	C  SEE FORTRAN MAN. FOR VALUES OF NON-NUMS.
24400		M=16
24500	C  IF I IS '0', NALF WILL BE 0, 'A'=1
24600	10	NALF=(I-J)/536870912-M
24700		END
24800	
24900	
25000		SUBROUTINE EDIT(JJA)
25100		COMMON/ALF/INP(72),ML
25200		COMMON /SC/JL,LJ,MK
25300		1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JM,JN,DBST,NFLG,IXX,ISEMI,QQ
25400		1 ,RVX(50),IAMP,A,KN,B,MODE,IBLA
25500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
25600		COMMON/RRJJ/RJJ2,RJJ(20)
25700		EQUIVALENCE (RVX1,RVX(1)),(RVX2,RVX(2)),(RVX4,RVX(4))
25800		1,(RVX3,RVX(3)),(RJ6,RJJ(4)),(RJ9,RJJ(7)),(R3,RJQ(1))
25850		1,(RJ5,RJJ(3))
25900		JN=-1
26000	C  THIS IS FLAG IN SCANR
26100		INP(20)=ISEMI
26200		ML=1
26300		RVX2=0
26400		RVX4=0
26500	C E=EDIT(55), C=COPY(2222), X=EXIT(222), DE=DEL(99), L=LTPN
26600		CALL SCANR
26700		JN=0
26800		R2=RVX2
26900		IF(RVX1.LT.10.)GO TO 7
27000		JA=RVX1
27100		IF(JA.EQ.99)R2=0
27200		IF(R2.NE.0)RETURN
27250		IF(JA.NE.55)RETURN
27300	5	CALL LPEN(R3,R2,K)
27400	C  CURSOR WILL FIND HORIZ. POSITION FOR 55 EDIT.
27500		RVX1=2.
27600		RVX3=R2-RJJ2
27700		RVX3=3.
27800		RJQ(2)=0
27900		RJJ(1)=RJQ(1)
28000	C ↑↑↑↑↑↑↑↑↑↑↑↑?????????
28100	C  SO JD WILL BE 0 IN MAIN PROG.
28200		GO TO 8
28300	C  FOR EDIT MODE
28400	7	JA=0
28500		IF(RVX2.NE.0)GO TO 8
28600		IF(RVX1.NE.4)GO TO 5
28700		RETURN
28800	C   FOR LIGHT PEN MOVING
28900	8	IF(JA.EQ.55)RETURN
29000		R2=.00001
29100		JA=0
29200		K=RVX1
29300	857	GO TO (1,2,3,4,2),K
29400	4	RVX2=-RVX2
29500	CC3	IF(JJA.EQ.17.OR.JJA.EQ.7.OR.JJA.EQ.18)GO TO 12
29600	C  SKIP OVER CLEFS (JJA=3) IS NOW REMOVED. 6/73
29700	3	CALL MVBEAM(RJJ,0,2,2,RVX2)
29800	C  MOVES UP AND DOWN.  HANDLES MINIS, ETC.
30000	      IF(JJA.LT.4)GO TO 856
30050		IF(JJA.GT.6)GO TO 856
30100	C   I THINK R2 MUST BE NON-ZERO TO WORK IN EDIT MODE?
30200	12	IF(RJJ(3).EQ.50)GO TO 856
30300	C   50=CRESC.-DECRESC.
30400	CC	K=3
30500	CC	IF(JJA.EQ.17.OR.JJA.EQ.18)K=4
30600		RJ5=RJ5+RVX2
30700	C  MOVES 5TH PARAM UP OR DOWN
30800		GO TO 856
30900	1	RVX2=-RVX2
31000	2	R2=RVX2
31100	856	IF(RVX4.EQ.0)GO TO 858
31200		K=RVX3
31300		RVX2=RVX4
31400		RVX4=0
31500		GO TO 857
31600	858	IF(R2.EQ..00001)GO TO 7515
31700		IF(JJA.LT.5)GO TO 477
31750		IF(JJA.LE.8)GO TO 5515
31800	477	IF(JJA.NE.4)GO TO 7515
31850		IF(RJ6.EQ.0)GO TO 7515
31900	C  ABOVE FOR P1=6 (BEAMS, SLURS, LINES)
32000	5515	RJ6=RJ6+R2
32100		IF(RJ9.EQ.0)GO TO 7515
32150		IF(JJA.EQ.6)RJ9=RJ9+R2
32200	C  RJ9(P9) IS LOC. OF INNER NOTE IN BEAM RANGE.
32300	7515	RJJ(1)=R2+RJJ(1)
32400		END
32500	
32600		SUBROUTINE PRESCN
32700	C  THIS SORTS OUT NEW INPUT FORMAT - CREATES OLD STYLE.
32800		DIMENSION IR(1)
32900		COMMON/ALF/INP(72),M/XRN/RN(4000)
33000		EQUIVALENCE (IR,RN(2001))
33100	C  CHECK THIS EQUIV.↑↑↑↑
33200	100	IF(ISM)5,55,555
33300	C  -1=PROCESS SOME MORE, 0=1ST TIME, 1=PUT OUT RHYTH
33400	55	JX=0
33500	5	K=0
33600		J=0
33700		I=JX
33800		JX=JX+72
33900	1	K=K+1
34000		M=INP(K)
34100	15	IF(M.EQ.' ')GO TO 1
34150		IF(M.EQ.',')GO TO 1
34200	C  REMOVE BLANKS AND COMMAS
34300		JN=0
34400		IF(M.LT.'0')GO TO 677
34450		IF(M.LE.'9')GO TO 2
34500	677	MM=INP(K+1)
34710	3	IF(M.EQ.'P')GO TO 8
34720		IF(M.EQ.'O')GO TO 8
34730		IF(M.LT.'A')GO TO 777
34740		IF(M.GT.'G')GO TO 777
34750		IF(MM.EQ.'L')GO TO 777
34760		IF(MM.NE.'A')GO TO 8
34800	C  FINDS NOTES, PROX., AND ORDINARY, -- NOT 'BA' OR 'AL'
34900	777	IF(M.NE.'R')GO TO 9
35000		IF(MM.EQ.'E')JN=1
35100	C  CATCHES 'R' 'RI' 'REP'
35200		GO TO 8
35300	9	IF(M.EQ.'/')GO TO 8
35310		IF(M.EQ.';')GO TO 8
35320		IF(M.EQ.'*')GO TO 8
35330		IF(M.EQ.':')GO TO 8
35400		JN=-1
35500	8	J=J+1
35600		 INP(J)=M
35700		IF(M.EQ.'X')JN=1
35800	C  PICKS UP 4X ETC. FOR BOTH NOTES AND RHYTH.
35900		IF(JN.LE.0)GO TO 13
36000	C  PUTS 'REP' INTO RHYTH ALSO
36100		I=I+1
36200		IR(I)=M
36300	13	IF(M.EQ.'/')GO TO 4
36310		IF(M.EQ.';')GO TO 4
36320		IF(M.EQ.'*')GO TO 4
36400		K=K+1
36500		M=INP(K)
36600		GO TO 8
36700	
36800	4	IF(JN.NE.0)GO TO 7
36900		I=I+1
37000		IR(I)=M
37100	7	IF(M.EQ.'/')GO TO 1
37200		IF(M.EQ.';')GO TO 11
37300		IF(M.EQ.'*')GO TO 6
37400	
37500	2	I=I+1
37600		IR(I)=M
37700		K=K+1
37800		M=INP(K)
37900		IF(M.EQ.'.')GO TO 2
37910		IF(M.LT.'0')GO TO 15
37920		IF(M.LE.'9')GO TO 2
38000	C  NO BLANK NEEDED AFTER RHYTH.( /4.AS3/8/ ETC.)
38100		GO TO 15
38200	
38300	11	IF(IR(I).NE.';')IR(I)=';'
38400		ISM=-1
38500		RETURN
38600	C  WE'LL COME BACK FOR MORE.
38700	
38800	6	IF(IR(I).NE.'*')IR(I)='*'
38900		JX=0
39000		ISM=1
39100	C AFTER THIS WE USE RHYTJ DATA.
39200		RETURN
39300	
39400	555	DO 12 K=1,72
39500		M=IR(K+JX)
39600		INP(K)=M
39700		IF(M.EQ.';')GO TO 10
39800	C  MORE THAN ONE LINE
39900	12	IF(M.EQ.'*')GO TO 14
40000	10	JX=JX+72
40100	C  MOVE TO THE NEXT 'LINE'
40200		RETURN
40300	14	ISM=0
40400		END